perm filename VARBL.SAI[PUB,TES]1 blob
sn#129312 filedate 1974-11-03 generic text, type T, neo UTF8
00100 BEGOF("VARBL")
00200
00300 COMMENT
00400
00500 *** Variations at Different Sites ***
00600
00700 The variable FULLFILE is computed differently at TENEX sites.
00800
00900 ***
01000
01100 Variable assignment and evaluation.
01200
01300 ;
01400
01500 PROCEDURES
00100 PUBLIC SIMPLE PROCEDURE VARBL! ;$"#
00200 BEGIN "VARBL!"
00300 INTEGER J, K ;
00400 STRING S ;
00500 J ← -1 ;
00600 comment Internal Variables;
00700 FOR S ← "LINES", "COLUMNS", "!", "SPREAD", "FILLING",
00800 "!SKIP!", "!SKIPL!", "!SKIPR!",
00900 "NULL", "!INF", "FOOTSEP", "TRUE", "FALSE",
01000 "INDENT1", "INDENT2", "INDENT3", "LMARG", "RMARG",
01100 "CHAR", "CHARS", "LINE", "COLUMN", "TOPLINE", "XCRIBL", "CHARW",
01200 "XGENLINES", "UNDERLINE", "THISDEVICE", "THISFONT",
01300 "FOOTGAP", "FOOTSEPFONT", "TTY", "ODDLEFTBORDER", "EVENLEFTBORDER",
01400 "FULLFILE", "THISLINE", "MAXTEMPLATE", "ERRLF", "DEBUGFLAG",
01500 "VBPI", "HBPI", "!XGPLFTMAR", "MINCHARW",
01600 "FOOTGAP2", "MILLSPACING", "MILLPREFACE", "LINEPREFACE", "LINESPACING",
01650 "!XGPINTRA" DO
01700 BIND(DECLARE(SYMNUM(S), INTERNTYPE), J←J+1) ;
01800 comment Global Variables with Preset values ;
01900 VARASSIGN("FILE", IFILENAME) ;
02000 K ← CALL(0, "DATE") ;
02100 VARASSIGN("MONTH", (STR1 ← MONTH[K DIV 31 MOD 12 + 1])[1 TO ∞-1]) ;
02200 VARASSIGN("DAY", STR2 ← CVS(K MOD 31 + 1)) ;
02300 VARASSIGN("YEAR", STR3 ← CVS(K DIV 31 DIV 12 + 1964)) ;
02400 VARASSIGN("DATE", STR1 & STR2 & ", " & STR3 );
02500 K ← CALL(0,"TIMER")/3600 ; S ← CVS(K MOD 60) ; IF LENGTH(S)=1 THEN S ← "0"&S ;
02600 VARASSIGN("TIME", CVS(K DIV 60) & ":" & S) ;
02700 END "VARBL!" ;
00100 PUBLIC SIMPLE PROCEDURE VARASSIGN(STRING NAME, VAL) ;$"#
00200 VASSIGN(SIMNUM(NAME), 0, SYMIX, VAL) ;
00100 PUBLIC RECURSIVE BOOLEAN PROCEDURE ASSIGNMENT ;$"#
00200 IF NEXTSCH(←) THEN
00300 BEGIN
00400 VASSIGN(SYMB, THISTYPE, IX, E(SPASS(PASS), 0)) ;
00500 IF ITSCH(;) THEN PASS ; RETURN(TRUE) ;
00600 END
00700 ELSE RETURN(FALSE) ;
00100 PUBLIC SIMPLE PROCEDURE DVARIABLE ;$"#
00200 DO BEGIN
00300 DPASS ;
00400 IF THISISID THEN
00500 BEGIN
00600 IF ON THEN
00700 BIND(SYMB←DECLARE(SYMB, LOCALTYPE), IX←PUSHS(1,NULL)) ;
00800 PASS ;
00900 END
01000 ELSE BEGIN WARN("=","LOCAL declaration missing identifier"); IF THISTYPE NEQ TERQ THEN PASS END ;
01100 END UNTIL NOT ITSCH(<,>) ;
00100 PUBLIC STRING SIMPLE PROCEDURE EVALV(STRING THISWD ; INTEGER IX, TYP) ;$"#
00200 BEGIN comment, evaluates the "variable" in THISWD ;
00300 OWN INTEGER ERR!EVALV ;
00400 CASE TYP OF
00500 BEGIN COMMENT BY TYPE ;
00600 [0] BEGIN IF ON THEN WARN("=","Undefined Identifier " & THISWD) ; RETURN(VIRGIN) END ;
00700 [GLOBALTYPE] RETURN(STBL[IX]) ;
00800 [LOCALTYPE] RETURN(SSTK[IX]) ;
00900 [INTERNTYPE]
01000 BEGIN "INTERNALVARIABLE"
01100 RETURN(CASE IX OF (
01200 COMMENT 0 ... LINES ; CVS(ABS(LINESLEFT)),
01300 COMMENT 1 ... COLUMNS; CVS(CASE STATUS+1 OF (
01400 COMMENT -1 ... no place area ; 0,
01500 COMMENT 0 ... unopened area ; COLS-(IF LINESLEFT<0 THEN 1 ELSE 0),
01600 COMMENT 1 ... open area ; COLSLEFT,
01700 COMMENT 2 ... closed area ; 0,
01800 COMMENT 3 ... dis-declared ; 0) ),
01900 COMMENT 2 ... ! ; !,
02000 COMMENT 3 ... SPREAD ; CVS(SPREADM),
02100 COMMENT 4 ... FILLING; IF NOT FILL THEN "0" ELSE IF ADJUST THEN "1" ELSE "-1",
02200 COMMENT 5 ... !SKIP! ; CVS(SAIL!SKIP!),
02300 COMMENT 6 ... !SKIPL!; CVS(LH(SAIL!SKIP!)),
02400 COMMENT 7 ... !SKIPR!; CVS(RH(SAIL!SKIP!)),
02500 COMMENT 8 ... NULL ; NULL,
02600 COMMENT 9 ... ∞ ; CVS(INF),
02700 COMMENT 10... FOOTSEP; FOOTSEP,
02800 COMMENT 11... TRUE ; "-1",
02900 COMMENT 12... FALSE ; "0",
03000 COMMENT 13... INDENT1; CVS(FIRSTIM),
03100 COMMENT 14... INDENT2; CVS(RESTIM),
03200 COMMENT 15... INDENT3; CVS(RIGHTIM),
03300 COMMENT 16... LMARG ; CVS(LMARG),
03400 COMMENT 17... RMARG ; CVS(RMARG),
03500 COMMENT 18... CHAR ; IF NOPGPH THEN "0" ELSE CVS(POSN), TES 0->"0" 5/26/74;
03600 COMMENT 19... CHARS ; CVS(IF NOPGPH THEN RMARG-LMARG ELSE MAXIM-POSN),
03700 COMMENT 20... LINE ; CVS(IF STATUS=1 THEN LINE ELSE 0),
03800 COMMENT 21... COLUMN ; CVS(IF STATUS=1 THEN COL ELSE 0),
03900 COMMENT 22... TOPLINE; CVS(LINE1(IF AREAIXM THEN AREAIXM ELSE IXTEXT)),
04000 COMMENT 23... XCRIBL; CVS(XCRIBL),
04100 COMMENT 24... CHARW ; CVS(CHARW),
04200 COMMENT 25... XGENLINES; CVS(XGENLINES),
04300 COMMENT 26... UNDERLINE ; VUNDERLINE, TES 10/22/73 ;
04400 COMMENT 27... THISDEVICE ; TES 11/15/73 ;
04500 CASE ABS(DEVICE)-1 OF ("LPT","TTY",
04600 IFCR PARCVER THENC PARCMNEMONIC ELSEC "MIC" ENDC,
04700 "XGP"),
04800 COMMENT 28... THISFONT ; IF THISFONT < 10 THEN
04900 THISFONT+"0" ELSE THISFONT+("A"-10),
05000 COMMENT 29... FOOTGAP ; CVS(FTGP), TES 11/27/73 ;
05100 COMMENT 30... FOOTSEPFONT ; PICKFONT(FSFONT)[3 FOR 1], TES 11/29/73 ;
05200 COMMENT 31... TTY ; TYPEIN, TES 11/29/73 ;
05300 COMMENT 32... ODDLEFTBORDER ; CVS(ODDLEFTBORDER), TES 6/11/74 ;
05400 COMMENT 33... EVENLEFTBORDER ; CVS(EVENLEFTBORDER), TES 6/11/74 ;
05500 COMMENT 34... FULLFILE ; FULLFILE, TES 10/15/74 ;
05600 COMMENT 35... THISLINE ; OWL[1 TO OAKS], TES 8/19/74 ;
05700 COMMENT 36... MAXTEMPLATE ; CVS(MAXTEMPLATE), TES 8/19/74 ;
05800 COMMENT 37... ERRLF ; CVS(ERRLF), TES 8/21/74 ;
05900 COMMENT 38... DEBUGFLAG ; CVS(DEBUGFLAG), TES 8/21/74 ;
06000 COMMENT 39... VBPI ; CVS(VBPI), TES 8/24/74 ;
06100 COMMENT 40... HBPI ; CVS(HBPI), TES 8/24/74 ;
06200 COMMENT 41... !XGPLFTMAR ; CVS((ODDLEFTBORDER*HBPI)/1000), TES 9/4/74 ;
06300 COMMENT 42... MINCHARW ; CVS(MINCHARW), TES 9/26/74 ;
06400 COMMENT 43... FOOTGAP2 ; CVS(FTGP2), TES 11/2/74 ;
06500 COMMENT 44... MILLSPACING ; CVS(MSPREADM), TES 11/2/74 ;
06600 COMMENT 45... MILLPREFACE ; CVS(IF NOFILL THEN MLEADNM ELSE MLEADFM), TES 11/2/74 ;
06700 COMMENT 46... LINEPREFACE ; CVS(IF NOFILL THEN LEADNM ELSE LEADFM), TES 11/2/74 ;
06750 COMMENT 47... LINESPACING ; CVS(SPREADM-1), TES 11/2/74 ;
06775 COMMENT 48... !XGPINTRA ; TES 11/2/74 ;
06787 CVS(((IF MILLVERTI<0 THEN MILLVERTIDEFAULT ELSE MILLVERTI)*VBPI)/1000),
06800 WARNN(ERR!EVALV,NULL,"PUB Bug: EVALV CASE number too high")
06900 ) ) ;
07000 END "INTERNALVARIABLE" ;
07100 [CMDTYPE] WARN("=",THISWD&" in an expression") ;
07200 [PORTYPE] RETURN(THISWD) ;
07300 [PCOUNTERTYPE] RETURN(PATT!VAL(PATT!STRS(IX))) ;
07400 [AREATYPE] RETURN(THISWD) ;
07500 [COUNTERTYPE] RETURN(CTR!VAL(PATT!STRS(IX)))
07600 END COMMENT BY TYPE ; ;
07700 RETURN(NULL) ;
07800 END "EVALV" ;
00100 PUBLIC STRING SIMPLE PROCEDURE VASSIGN(INTEGER VSYMB, VTYPE, VIX; STRING VAL) ;$"#
00200 BEGIN "VASSIGN" comment, NAME←VAL ;
00300 SIMPLE PROCEDURE RDONLY(STRING IV) ; WARN("=","The value of "&IV&" is read-only") ;
00400 IF ON THEN CASE VTYPE OF
00500 BEGIN COMMENT BY TYPE ;
00600 [0] BIND(VSYMB←DECLARE(VSYMB, GLOBALTYPE), PUTS(VAL)) ; COMMENT Undeclared identifier ;
00700 [GLOBALTYPE] STBL[VIX] ← VAL ;
00800 [LOCALTYPE] SSTK[VIX] ← VAL ;
00900 [INTERNTYPE] CASE VIX OF
01000 BEGIN COMMENT INTERNAL ;
01100 COMMENT 0 ... LINES ; RDONLY("LINES") ;
01200 COMMENT 1 ... COLUMNS; RDONLY("COLUMNS") ;
01300 COMMENT 2 ... ! ; ! ← VAL ;
01400 COMMENT 3 ... SPREAD ; SPREADM ← CVD(VAL) ;
01500 COMMENT 4 ... FILLING; RDONLY("FILLING") ;
01600 COMMENT 5 ... !SKIP! ; SAIL!SKIP! ← CVD(VAL) ;
01700 COMMENT 6 ... !SKIPL!; DPB(CVD(VAL), H1(SAIL!SKIP!)) ;
01800 COMMENT 7 ... !SKIPR!; DPB(CVD(VAL), H2(SAIL!SKIP!)) ;
01900 COMMENT 8 ... NULL ; RDONLY("NULL") ;
02000 COMMENT 9 ... ∞ ; RDONLY("∞") ;
02100 COMMENT 10... FOOTSEP; FOOTSEP ← VAL ;
02200 COMMENT 11... TRUE ; RDONLY("TRUE") ;
02300 COMMENT 12... FALSE ; RDONLY("FALSE") ;
02400 COMMENT 13... INDENT1; FIRSTIM ← CVD(VAL) ;
02500 COMMENT 14... INDENT2; RESTIM ← CVD(VAL) ;
02600 COMMENT 15... INDENT3; BEGIN RIGHTIM ← CVD(VAL) ; COMPMAXIMS END ;
02700 COMMENT 16... LMARG ; BEGIN LMARG ← CVD(VAL) MAX 0 MIN
02800 COLWID(IF AREAIXM THEN AREAIXM ELSE IXTEXT)-1 ; COMPMAXIMS END ;
02900 COMMENT 17... RMARG ; BEGIN RMARG ← CVD(VAL) MAX 1 MIN
03000 COLWID(IF AREAIXM THEN AREAIXM ELSE IXTEXT) ; COMPMAXIMS END ;
03100 COMMENT 18... CHAR ; RDONLY("CHAR") ;
03200 COMMENT 19... CHARS ; RDONLY("CHARS") ;
03300 COMMENT 20... LINE ; RDONLY("LINE") ;
03400 COMMENT 21... COLUMN ; RDONLY("COLUMN") ;
03500 COMMENT 22... TOPLINE; RDONLY("TOPLINE") ;
03600 COMMENT 23... XCRIBL ; RDONLY("XCRIBL") ;
03700 COMMENT 24... CHARW ; CHARW ← CVD(VAL) ;
03800 COMMENT 25... XGENLINES; XGENLINES ← CVD(VAL) ;
03900 COMMENT 26... UNDERLINE ; VUNDERLINE ← VAL ; TES 10/22/73 ;
04000 COMMENT 27... THISDEVICE ; RDONLY("DEVICE") ; TES 11/15/73
04100 COMMENT 28... THISFONT ; RDONLY("THISFONT") ; TES 11/15/73 ;
04200 COMMENT 29... FOOTGAP ; FTGP ← CVD(VAL) ; TES 11/29/73 ;
04300 COMMENT 30... FOOTSEPFONT ; FSFONT ← RFONT(VAL) ; TES 11/29/73 ;
04400 COMMENT 31... TTY ; BEGIN IF NOT SWDBACK THEN OUTSTR(CRLF) ;
04500 OUTSTR(VAL & CRLF) ;
04600 SWDBACK ← TRUE ;
04700 END ; TES 11/29/73 AND 4/11/74 ;
04800 COMMENT 32... ODDLEFTBORDER ; ODDLEFTBORDER ← CVD(VAL) ; TES 6/11/74 ;
04900 COMMENT 33... EVENLEFTBORDER ; EVENLEFTBORDER ← CVD(VAL) ; TES 6/11/74 ;
05000 COMMENT 34... FULLFILE ; RDONLY("FULLFILE") ; TES 6/13/74;
05100 COMMENT 35... THISLINE ; RDONLY("THISLINE") ; TES 8/19/74 ;
05200 COMMENT 36... MAXTEMPLATE ; MAXTEMPLATE ← CVD(VAL) ; TES 8/19/74 ;
05300 COMMENT 37... ERRLF ; ERRLF ← CVD(VAL) ; TES 8/20/74 ;
05400 COMMENT 38... DEBUGFLAG ; DEBUGFLAG ← CVD(VAL) ; TES 8/21/74 ;
05500 COMMENT 39... VBPI ; VBPI ← CVD(VAL) ; TES 8/24/74 ;
05600 COMMENT 40... HBPI ; HBPI ← CVD(VAL) ; TES 8/24/74 ;
05700 COMMENT 41... !XGPLFTMAR ;
05800 BEGIN
05900 OUTSTR(" !XGPLFTMAR->ODD/EVENLEFTBORDER ") ;
06000 ODDLEFTBORDER ← EVENLEFTBORDER ← (CVD(VAL)*1000)/HBPI ;
06100 END ; TES 9/4/74 ;
06200 COMMENT 42... MINCHARW ; MINCHARW ← CVD(VAL); TES 9/26/74 ;
06300 COMMENT 43... FOOTGAP2 ; FTGP2 ← CVD(VAL) ; TES 11/2/74 ;
06400 COMMENT 44... MILLSPACING ; MSPREADM ← CVD(VAL) ; TES 11/2/74 ;
06500 COMMENT 45... MILLPREFACE ;
06600 IF NOFILL THEN MLEADNM←CVD(VAL)
06700 ELSE MLEADFM ← CVD(VAL) ; TES 11/2/74 ;
06800 COMMENT 46... LINEPREFACE ;
06900 IF NOFILL THEN LEADNM←CVD(VAL)
07000 ELSE LEADFM ← CVD(VAL) ; TES 11/2/74 ;
07050 COMMENT 47... LINESPACING ; SPREADM ← CVD(VAL)+1 ; TES 11/2/74 ;
07075 COMMENT 48... !XGPINTRA ; TES 11/2/74 ;
07077 IF MILLVERTI GEQ 0 THEN
07080 WARN(NULL,<"Too late to set !XGPINTRA" & CRLF &
07085 "Better to use SPACING n MILLS anyway">)
07090 ELSE MILLVERTI ← (CVD(VAL)*1000)/VBPI ;
07100 END ; COMMENT INTERNAL ;
07200 [CMDTYPE] WARN("Improper use of ←",<"← after reserved word "&SYM[VSYMB]&" -- assignment ignored">) ;
07300 [PORTYPE] WARN("=","← after PORTION name "&SYM[VSYMB]) ;
07400 [PCOUNTERTYPE] PATT!VAL(PATT!STRS(VIX)) ← VAL ;
07500 [AREATYPE] WARN("=","← after Area name "&SYM[VSYMB]) ;
07600 [COUNTERTYPE] CTR!VAL(PATT!STRS(VIX)) ← VAL
07700 END ; COMMENT BY TYPE ;
07800 RETURN(VAL) ;
07900 END "VASSIGN" ;
00100 PUBLIC STRING SIMPLE PROCEDURE VEVAL ;$"#
00200 RETURN(EVALV(THISWD, IX, THISTYPE)) ;
00100 FINISHED
00200
00300 ENDOF("VARBL")